perm filename PFAIL.FAI[PAG,LCS]8 blob
sn#390620 filedate 1978-10-20 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00003 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE PFAIL ********* OCT 78 *********
C00040 00003 MOVEM @(16)
C00051 ENDMK
C⊗;
TITLE PFAIL; ********* OCT 78 *********
INTERNAL PUTEXT,EXTOUT,GETEXT,EXTIN,FINEXT
ENTRY LOOKF,LOOKX,LOOK,SHFTQ,SORT2,NORH,FNDEND,MINMAX
ENTRY RLOOP,BLTEM,IFIX,FLOAT
;; ENTRY PFIBX,PFIB,RLOOP,BLTEM,IFIX,FLOAT
ENTRY GETPTS,MOVIT,EXTEN,DBAR,QRN,SORT,SHIFT,SHFT1,SHFT0
ENTRY PSHFT,ADRST,STAFF,RIGHT,RESTS,EXCHG,EXCH,SHRNK,EXPND,CLFNUM
ENTRY SLRV,CLEFN,MMNN,CODEN,ZERO,BARFAC
EXTERNAL .COMM.,XRN,KJY,PTR,POSI,AMOD,KNR,NNP,PX,XXX,Q,SF,LLL
EXTERNAL RCLF,STF,PTMOVE,IPG,JN,RCLF,MNX,ALOG,ENDL
DEFINE ERROR (MSG)
< JSA 16,.ERROR
JUMP [ASCIZ/MSG/
]
>
.ERROR: 0
OUTSTR [ASCIZ/?
/] ;MAKE SURE HE CAN SEE HIS ERROR
OUTSTR @(16) ;OUTPUT ERROR MESSAGE
CALLI 1,12 ;LET USER CONTI2UE
JRA 16,1(16)
CH←13
REGS: BLOCK 20
;LOOK(<FILE>) FOR NO EXT., LOOKD() FOR .DAT, LOOKF() FOR .DMD
LOOKF: 0
MOVSI 0,'DMD'
JRST LOOK1
LOOKX: 0
MOVE 0,@1(16)
MOVEM 0,FILNAM
JSA 16, INTFIQ
MOVE 0,DIR
JRST LOOK1
LOOK: 0
MOVEI 0,0
LOOK1: MOVEM 0,DIR+1
MOVE 0,@(16)
MOVEM 0,FILNAM
JSA 16, INTFIQ
SETZM DIR+2
SETZM DIR+3
LOOKUP CH,DIR
TDZA 0,0
MOVNI 0,1
JRA 16,1(16)
INTFIQ: 0 ;INITS DSK FOR INPUT
MOVEI REGS
BLT REGS+3
INIT CH,17
SIXBIT/DSK/
0
HALT .-3
; ERROR <CAN'T INIT DSK!>
PUSHJ 17,INTF4
JRA 16,0(16)
INTF4: MOVE 0,FILNAM#
MOVEM 0,FN#
MOVE 1,[POINT 7,FN]
INTF3: MOVE 2,[POINT 6,DIR]
SETZM DIR
MOVEI 3,5
INTF1: ILDB 0,1
CAIN 0," "
JRST INTF2
SUBI 0,40
IDPB 0,2
SOJG 3,INTF1
INTF2: HRLZI REGS
BLT 3
POPJ 17,
DIR: BLOCK 4
SHFTQ: 0 ;CALL SHFTQ(R)
MOVE JN+1
SOS
SETZ 1,
MOVE 3,@(16) ;R
SHQ: MOVE 2,XRN(1)
FADRM 3,Q-1(2)
CAMGE 1,0
AOJA 1,SHQ
JRA 16,1(16)
SORT2: 0 ;SUBROUTINE SORT2(RPOS,M)
MOVEI 2,2 ;DIMENSION RPOS(2,200)
SO3: MOVE 6,2 ;(K=L HERE)
SETO 11, ;L=2
HRRZI 3,@(16) ;3 J=-1
MOVE 4,2 ;RX=RPOS(1,L-1)
SUBI 4,1 ;L-1
IMULI 4,2
ADDI 4,(3)
MOVE 5,-2(4) ;RX
SO2: MOVE 7,6 ; DO 2 K=L,M
;IF(RPOS(1,K).GE.RX)GO TO 2
IMULI 7,2 ;IF(RPOS(1,K).GE.RX)GO TO 2
ADDI 7,(3)
CAMG 5,-2(7)
JRST SO1 ; CONTINUE
MOVE 5,-2(7) ; RX=RPOS(1,K)
;;C WHY WERE ALL THE RX'S JX ????? 9/6/73
MOVE 11,6 ;J=K
SO1: CAMGE 6,@1(16) ;2 CONTINUE
AOJA 6,SO2
JUMPL 11,SO4 ;IF(J)GO TO 4
MOVE 12,2 ;K=L-1
SOS 12
IMULI 12,2 ;(K*2)
ADD 12,3 ;CALL EXCH(RPOS(1,K),RPOS(1,J))
MOVE 10,-2(12)
IMULI 11,2
ADD 11,3
EXCH 10,-2(11)
MOVEM 10,-2(12)
MOVE 10,-1(12) ;CALL EXCH(RPOS(2,K),RPOS(2,J))
EXCH 10,-1(11)
MOVEM 10,-1(12)
SO4: CAMGE 2,@1(16) ;4 L=L+1
AOJA 2,SO3 ;IF(L.LE.M)GO TO 3
JRA 16,2(16) ;END
NORH: 0 ;FUNCTION NORH(KK)
MOVE 1,XRN+=499(15) ;FIND VALUE IN NN ARRAY IN DO LOOP.
MOVEM 1,@(16) ;KK=NN(K)
SETZ 0,
JUMPLE 1,NOR
CAILE 1,2 ;NORH=-1 IF KK≤0, >18, NOT 1,2,4,17.
CAIN 1,4
JRA 16,1(16)
CAIE 1,=18 ;USED IN RESPC.F4
CAIN 1,=17
JRA 16,1(16)
NOR: SETO 0,
JRA 16,1(16)
FNDEND: 0 ;CALL FNDEND(R)
SETZ 1,
FA: MOVE 2,XRN+=500(1) ;NN(K)
JUMPLE 2,FB
CAIG 2,3
JRST FC
CAIE 2,=17
CAIN 2,=18
SKIPA
FB: AOJA 1,FA ;ASSUMES IT WILL ALWAYS END PROPERLY!!!
FC: MOVN 2,XRN(1) ; MM(K)
FADR 2,[2.0]
FADR 2,ENDL ;+ENDLN
;; FADR 2,RSP+=20 ;+ENDLN
MOVEM 2,@(16)
JRA 16,1(16)
MINMAX: 0 ; SUBROUTINE MINMAX(JRN)
MOVE 1,(16) ;COMMON /MNX/MIN,MAX,JT DIM. JRN(1)
;; MOVE 1,0 ; COMMON /MNX/MIN,MAX,JT /XRN/JRN(1)
MOVE 0,(1) ;GET FIRST VALUE OF CURRENT JRN ARRAY
MOVE 3,
MOVEI 2,2 ; MIN=10000
;;MM: CAMLE 0,XRN-1(2) ; MAX=0
MM: CAMLE 0,1(1) ; MAX=0
MOVE 0,1(1) ; DO 107 K=1,JT
CAMGE 3,1(1) ; NN=JRN(K)
MOVE 3,1(1) ; IF(NN.LT.MIN)MIN=NN
AOJ 1,
CAMGE 2,MNX+2
AOJA 2,MM ;107 IF(NN.GT.MAX)MAX=NN
MOVEM 0,MNX ; END
MOVEM 3,MNX+1
JRA 16,1(16)
PFIBX: 0 ;DATA FIB/0.618/, RFIB/-.382/,ALG/0.30103/
;100 ACCEPT 10,A 10 FORMAT(F)
MOVE 12,@(16) ;PFIBX=14
MOVE 13,[14.0] ;IF(A.EQ.1)GO TO 20
CAMN 12,[1.0] ;Z=FIB
JRST PFX ;IF(A.LT.1)Z=RFIB
JSA 16,ALOG ;RH=ABS(ALOG(A)/ALOG(2.0))
JUMP 12
FDVR 0,[0.6931472]
MOVM 11,0
MOVE 10,[0.618]
SKIPG ;L=RH
MOVN 10,[0.382] ;IF(L.EQ.0)GO TO 4
KIFIX 7,11
MOVE 6,7 ;SAVE L FOR LATER
JUMPE 6,PFZ
PF: MOVE 2,13 ; DO 3 K=1,L
FMPR 2,10 ;3 PFIBX=PFIBX+PFIBX*Z
FADR 13,2
SOJG 6,PF
PFZ: FLTR 7,7 ;4 RH=RH-L
FSBR 11,7 ;IF(RH.EQ.0)GO TO 20
JUMPE 11,PFX
MOVE 2,13
FMPR 2,10
FMPR 2,11 ;PFIBX=PFIBX+PFIBX*Z*RH
FADR 13,2
PFX: MOVE 0,13 ;SEND BACK THE RESULT
JRA 16,1(16)
PFIB: 0 ;FUNCTION PFIB(P) PSEUDO-FIBONACCI RHYTHM SPACER
MOVN 0,@(16) ;PFIB=(P+(.125-P)*(.8+.01*P))*50
FADR 0,[0.125] ;END
MOVE 1,@(16)
FMPR 1,[0.02]
FADR 1,[0.8]
FMPR 0,1
FADR 0,@(16)
FMPR 0,[50.0]
JRA 16,1(16)
RLOOP: 0 ;CALL RLOOP(A,B,K)
HRLI 1,@1(16) ;DIMENSION A(1),B(1) -- SOURCE
HRRI 1,@(16) ;DO 1 J=1,K -- DESTINATION
MOVE 2,(16) ;1 A(J)=B(J) -- WORD COUNT
ADD 2,@2(16) ;LOC OF ARRAY A + WDCNT.
BLT 1,-1(2)
JRA 16,3(16)
BLTEM: 0
HRLI 1,PX ;KWDS(...)=KPN(...) PX IS LOC. OF KPN ARRAY
HRRI 1,PTR ;RIGHT HALF IS LOC OF KWDS ARRAY
MOVE 2,RCLF+3 ;GET NUM. OF ITEMS (RCLF+3=ITEM)
BLT 1,PTR(2) ; PTR(2) IS WD CNT. (ITEM+1)
HRLI 1,Q ;RN(...)=Q(...)
HRRI 1,XRN
MOVE 2,POSI+=9 ;THIS IS JPQ, NUM OF WDS.
BLT 1,XRN-1(2)
JRA 16,0(16)
IFIX: 0
KIFIX 0,@(16)
JRA 16,1(16)
FLOAT: 0
FLTR 0,@(16)
JRA 16,1(16)
K←15↔J←14↔ M←2↔ R2←5↔ X←6↔ L←4↔ R←7↔ A←11↔RY←3↔RZ←13↔JJ2←12
; SUBROUTINE GETPTS
; COMMON/KNR/N(500) /NNP/NP(500)
;XXX COMMON/XRN/RN(4000) /KJY/ K,J
; COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS
;XXX 1/PTR/PWDS(250),ITEM,LL,I,IX
; EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
; 1,(R6,RJQ(4))
GETPTS: 0 ;CALL GETPTS(N,RN,PWDS)
SETZ J, ; J=0
SETZ K, ; K=0
MOVE JJ2,POSI+=8
KIFIX R2,.COMM. ;GET THE STAFF NUM. (NEG= ALL IN THIS PROG.)
SETZ X,
MOVEI M,@2(16); DO 1 M=1,ITEM
G1: AOJ X,
MOVE L,(M)
MOVEI R,@1(16) ;L=PWDS(M)
ADDI R,(L) ;IF(RTLINE(L))GO TO 1
JUMPL R2,G9 ;NEG R2=ALL STAVES
KIFIX A,1(R) ;CHECK NOW FOR CORRECT STAFF
CAME R2,A
JRST GX ;NOT THE ONE.
;* MOVE 1,1(R) ;RN(L+2)
;;NEVER USED IN 'PARTS'- CAML R2,[=5.0]
;; JRST GZ
;PT MOVE A,1(R)
;; SKIPE IPG ;IF(IPG)GO TO GSTF
;; JRST GSTF
;; KIFIX A,A
;; FLTR A,A ;STAFF=IFIX(STAFF) DROPS DECIS.
;PT SKIPL IPG
;PT JRST G9
;PTGSTF: CAME R2,A ;FINDS STAFF #
;PT JRST GX
;;GZ: MOVE A,.COMM.+7 ;RY=RN(L+1)
;; JUMPLE A,G9 ;F(R6.LE.0)GO TO 9
;; CAME A,(R) ;IF(R6.NE.RY)GO TO 1
;; JRST GX
; CHECK CODE NUM
G9: MOVE A,2(R)
CAMG A,.COMM.+6 ;R5 9 IF(OUTLIM(R4,R5,RN(L+3)))GO TO 2
CAMGE A,.COMM.+5 ;R4
JRST G2
SKIPG JJ2
MOVE JJ2,X
MOVE .COMM.+=8 ;IF(IPG)RN(L+2)=R7
AOJ J,
; IN LIMITS?
; MOVEI A,XRN+=2498 ;J=J+1
;; MOVEI A,KNR-1
;; ADDI A,(J)
MOVEI 0,(L)
AOJ K, ;K=K+1
;; MOVEI 1,NNP-1
;; ADDI 1,(K) ;NP(K)=L
MOVEM 0,NNP-1(K)
ADDI 0,3 ;N(J)=L+3
MOVEM 0,KNR-1(J)
; NP IS FOR USE IN JUSTIFY ROUTINE
G2: KIFIX RY,(R) ;2 IF(RY.LT.4)GO TO 1
CAIN RY,2 ;IF(RY.EQ.2)GO TO GRST
JRST GRST
CAIGE RY,4
JRST GX
MOVE RZ,-1(R) ;RZ=RN(L) WD CNT
CAIE RY,=44 ;CODE 4 IS SOMETIMES =44
JRST .+4
CAMG RZ,[2.0] ;IF(RZ.LE.2)THEN IT'S AN CODE 44 BAR LINE.
JRST GX
JRST G5 ;FOUND A LINE
CAILE RY,7
JRST GX ;IF(RY.GT.7)GO TO 1
; TWO-ENDED ITEM?
;; CAMN RY,[=4.0] ;GO TO(4,5,6,7),IFIX(RY)-3
;; JRST G4
;; CAMN RY,[=5.0]
;; JRST G5
;; CAMN RY,[=6.0]
;; JRST G6
;; CAMG RZ,[=4.0] ;4 IF(RZ.GT.2)GO TO 5
;; JRST G5 ; THERE IS A TRILL WIGGLE
;; JRST GX ;GO TO 1 -- NO WIGGLE (P7≠0)
XCT TBL-4(RY) ; NEXT REPLACES THE ABOVE.
JRST G5
JRST GX
TBL: JRST G4
JRST G5
JRST G6
CAMG RZ,[4.0]
G4: CAMG RZ,[=3.0] ;7 IF(RZ.GT.3)GO TO 5
JRST GX
JRST G5 ;GO TO 1
GRST: MOVE RZ,-1(R) ;FOR 'CENTERED' RESTS
JRST G8
G6: CAMGE RZ,[=8.0] ;6 IF(RZ.LT.8)GO TO 8
JRST G8
SKIPL 6(R) ;IF(R7)GO TO 8
SKIPN =9(R) ;IF(R10.EQ.0)GO TO 8
JRST G8
;; MOVE A,7(R) ; IF(OUTLIM(R4,R5,RN(L+8)))GO TO 8
;; JUMPE A,G5 ;IF(R8.EQ.0)GO TO G5(MOVE ONLY P3,6)
SKIPG A,7(R) ;IGNORE P8 IF IT IS 0 OR -
JRST G8
CAMG A,.COMM.+6
CAMGE A,.COMM.+5
JRST G8
CAMLE JJ2,X
MOVE JJ2,X
AOJ J, ; IN LIMITS?
MOVEI 0,=8(L) ;J=J+1
MOVEM 0,KNR-1(J)
G8: CAML RZ,[=7.0] ;8 IF(RZ.LT.7)GO TO 5
SKIPG A,8(R) ; R9 IF(R9.LE.0)GO TO G5
JRST G5
CAIE RY,2 ;IF(RY.EQ.2)GO TO GRST2 (NEW CENTERED RESTS)
SKIPE 7(R) ; R8
JRST GRST2
SKIPL 6(R) ; R7
JRST G5
GRST2: CAMG A,.COMM.+6
CAMGE A,.COMM.+5 ;R4
JRST G5
CAMLE JJ2,X
MOVE JJ2,X
AOJ J, ;J=J+1 ; IN LIMITS?
MOVEI 0,=9(L)
MOVEM 0,KNR-1(J) ;N(J)=L+9
G5: CAIN RY,2 ;IF(RY.EQ.2)GO TO GX
JRST GX
MOVE A,5(R)
CAMG A,.COMM.+6
CAMGE A,.COMM.+5 ;R4
JRST GX
CAMLE JJ2,X
MOVE JJ2,X
AOJ J, ; IN LIMITS?
;| MOVEI A,XRN+=2498 ;J=J+1
;; ADDI A,(J)
MOVEI 0,6(L) ;5 IF(OUTLIM(R4,R5,RN(L+6)))GO TO 1
;; ADDI 0,6 ;N(J)=L+6
MOVEM 0,KNR-1(J)
;;GX: CAMGE X,PTR+=250 ;1 CONTINUE
GX: CAMGE X,LLL ;1 CONTINUE
AOJA M,G1
MOVEM JJ2,POSI+=8
MOVEM J,KJY+1
MOVEM K,KJY
JRA 16,3(16)
; SUBROUTINE MOVIT(RN,NP,R4,R5,R8,R9)
; DIMENSION NP(1),RN(1)
; COMMON /KJY/ DONT,J
MOVIT: 0 ;RDIS=(R9-R8)/(R5-R4)
MOVE R,@5(16)
FSBR R,@4(16)
MOVE RY,@3(16)
FSBR RY,@2(16)
FDVR R,RY
; MOVEI L,XRN+=2499 ; DO 1 K=1,J
MOVE L,1(16) ; GET NP ARRAY LOC
SETZ K,
MOVE 0,@5(16) ; SET UP R9
;;M1: MOVE X,L ; L=NP(K)
M1: MOVEI R2,@(16) ;RA=RN(L)
ADD R2,(L)
MOVEI RZ,(R2)
MOVE R2,-1(R2)
CAML R2,@2(16) ;IF(OUTLIM(R4,R5,RA))GO TO 1
CAMLE R2,@3(16)
JRST MX
JUMPE 0,M2 ;IF(R9.NE.0)RA=(RA-R4)*RDIS
FSBR R2,@2(16)
FMPR R2,R
M2: FADR R2,@4(16) ; RN(L)=R8+RA
MOVEM R2,-1(RZ)
MX: AOJ K, ;1 CONTINUE
CAMGE K,KJY+1
AOJA L,M1
JRA 16,6(16)
EXTEN: 0 ;FUNCTION EXTEN(X)
HRRM 16,.+2
JSA 16,AMOD ;EXTEN=AMOD(X,1.)*10.
JUMP @0
JUMP [=1.0]
FMPR [=10.0]
JRA 16,1(16)
DBAR: 0 ; CALL DBAR(K,ITEM,J)
MOVE 4,@2(16) ; -J-RR=RN(J+3)
;PT SKIPL IPG ;IF(IPG.GE.0)LEAVE BAR ALONE!
JRST DB1
;PT KIFIX 2,XRN+3(4) ; -RN(J+4)-
;KZ=RN(J+4)/100.
;PT IMULI 2,=100 ;RN(J+4)=1.+KZ*100.
DB1: MOVE 1,@1(16)
MOVE 7,XRN+2(4) ; -RR-
MOVE 4,@(16) ; DO 82 KY=K+1,ITEM
DB: MOVE 5,PTR(4) ;KZ=PWDS(KY)
MOVE 6,XRN(5) ; IF(RN(KZ+1).NE.4)GO TO 82
CAME 6,[4.0]
JRST DB82
MOVE 6,XRN-1(5) ;IF(RN(KZ).GT.3)GO TO 82
CAMLE 6,[3.0]
JRST DB82
;;C AVOIDS DUPLICATE BARS.
MOVN 6,XRN+2(5) ;IF(ABS(RR-RN(KZ+3)).GT..5)GO TO 82
FADR 6,7
SKIPGE 6
MOVNS 6
CAMLE 6,[0.5]
JRST DB82
MOVE 6,[99.0] ;RN(KZ+2)=99
MOVEM 6,XRN+1(5)
SETZM XRN(5) ;RN(KZ+1)=0
DB82: AOJ 4, ;82 CONTINUE
CAIGE 4,(1)
JRST DB
MOVEM 7,SHFT1 ; RR SAVES IT FOR ADRST ROUTINE
JRA 16,3(16)
QRN: 0 ; CALL QRN(J,XWDS,K)
MOVE 4,@(16) ;810 JA=PWDS(K+1)
PN4: MOVE 5,@2(16) ; DO 7 KY=J,JA-1
MOVE 5,PTR(5) ; - JA -
MOVE 6,XXX ; PN(LK)=RN(KY)
MOVEI 1,(6) ; SAVE IT FOR A LITTLE LATER
PN: MOVE 7,XRN-1(4) ;7 LK=LK+1
MOVEM 7,Q-1(6)
AOJ 4, ;AC4 IS KY, AC6 IS LK
CAME 4,5
AOJA 6,PN
SKIPN SF ;IF(KL.EQ.0)GO TO PN5
JRST PN5
MOVE [1.0] ;PUT A 1.0 AS RHYTHM FOR REST OR NOTE
ADD 6,SF
MOVEM Q-1(6) ;PUT IT IN PARAM 7 OR 9
PN5: AOJ 6,
MOVE 2,.COMM.+6 ; IF(R5)GO TO 6666
JUMPL 2,PN2 ; IF(PN(J).EQ.2)LK=LK+1
MOVEM 2,Q+4(1) ; PN(J+5)=R5
MOVE 3,[3.0]
PN3: MOVE 4,3 ; IS THE WDCNT BIG ENOUGH?
FSBR 4,Q-1(1)
KIFIX 4,4
ADD 6,4 ; UPDATE THE MAIN COUNTER
;PT??? SETZM Q+3(1) ; ZERO PARAM 4, THE VERTICAL POS. PN(J+4)
MOVEM 3,Q-1(1) ; PN(J)=3 OR 4
JRST PN1
PN2: MOVE 3,RCLF ; IF(R.NE.17)GO TO
CAME 3,[17.0]
JRST PN1
MOVE 3,[4.0] ; THE WDCNT
MOVE 2,RCLF+1 ; CLEF #
MOVEM 2,Q+5(1) ;PN(J+6)=CLEF
JRST PN3
PN1: MOVEM 6,XXX ;LK=LK+1 (6666↑)
MOVE 4,LLL ; -L- XWDS(L)=LK
ADD 4,1(16) ; ADDR. XWDS ARRAY
MOVEM 6,(4)
AOS LLL ;L=L+1
JRA 16,3(16)
SORT: 0 ; CALL SORT(XWDS)
MOVE 11,LLL ; L
SOJ 11,
MOVEI 4,1 ;I=1
MOVE 0,[16.0]
MOVE 1,[8.0]
SETZ 5, ; -K- DO 243 K=1,L-1
S2: MOVE 7,(16) ; ADDR. OF XWDS
ADDI 7,(5) ;LB=XWDS(K)+1
MOVE 6,(7)
;; MOVE 10,Q(6) ;IF(PN(LB).NE.16)GO TO 243
;; CAME 10,[16.0]
CAME 0,Q(6)
JRST S243
;; MOVE 10,Q-1(6) ;IF(PN(LB-1).LT.8)GO TO 243
;; CAMGE 10,[8.0]
CAMLE 1,Q-1(6)
JRST S243
MOVE 10,-1(7) ;JL=XWDS(K-1)
MOVE 10,Q+2(10)
MOVEM 10,Q+2(6) ;244 PN(LB+2)=PN(JL+3)
S243: AOJ 5,
CAME 5,11 ; -L-1
JRST S2 ; 243 CONTINUE
;; PUTS CONTINUATION OF TEXT IMMEDIATELY AFTER PREV. POS.
;; FOR SPACING PROBLEMS BELOW.
MOVEI 11,1 ;M=2
SETZ 12, ;J=1
S24: MOVE 13,[100000.0] ;24 RA=100000.;; POSITION
MOVE 1,LLL ; L
SOJ 1,
SETZ 14, ; -K-
S21: MOVE 2,(16) ;DO 21 K=1,L-1 - ADDR. OF XWDS -
ADDI 2,(14) ;JL=XWDS(K)+3
MOVE 2,(2)
MOVE 3,Q+2(2) ;R=PN(JL)
CAMN 3,[100000.0]
JRST SX21 ;IF(R.EQ.100000)GO TO 21
MOVE 3 ;241 IF(ABS(R-RA).GT..1)GO TO 240
FSBR 13
SKIPGE
MOVNS
CAMLE 0,[0.1]
JRST S240
MOVEM 13,Q+2(2) ; ((R=RA)) PN(JL)=R
JRST SX21 ;GO TO 21;; PUT IN HERE MULTI-VOICE TRAP SOMEDAY
S240: CAMLE 3,13 ;240 IF(R.GT.RA)GO TO 21
JRST SX21 ;; LINES THEM UP
MOVEI 4,(2) ; SAVES JL (I=K)
MOVE 13,3 ; RA=R ;21 CONTINUE
SX21: AOJ 14, ; -K-
CAME 14,1
JRST S21
CAMN 13,[100000.0] ;IF(RA.EQ.100000)GO TO 23
JRA 16,1(16); JUMP IF ALL SORTED
;;;; MOVE 10,(16) ;242 JL=XWDS(I)
MOVEI 15,(4) ;LA=JL
KIFIX 1,Q-1(4) ;N=PN(JL)+3
ADDI 1,3 ; N
MOVE 2,PTR-1(11) ; PWDS(M)=PWDS(M-1)+N
ADDI 2,(1)
MOVEM 2,PTR(11)
AOJ 11, ; M=M+1
;; FIXX(1) ;DO 22 K=J,J+N-1
ADDI 1,(12) ; -J+N-
S22: MOVE 2,Q-1(4) ; RN(K)=PN(JL)
MOVEM 2,XRN(12)
AOJ 12,
CAME 12,1
AOJA 4,S22 ;22 JL=JL+1
AOJ 4, ; (JL=JL+1)
MOVE 2,[100000.0] ; PN(LA+3)=100000
MOVEM 2,Q+2(15) ; PUT IT ASIDE
JRST S24 ; GO TO 24
SHIFT: 0 ; CALL SHIFT
SOS LLL ; (IN MAIN. L=L-1)
SETZ 2, ;K=1
SETZ 3, ;L=1
SETO 4, ;LK=1 ((LL=0))
SH221: MOVE 5,PX(2) ;221 IF(Q(IFIX(PN(K))+1))GO TO 321
MOVE 6,Q(5)
JUMPL 6,SH321
MOVE 7,PX+1(2)
SH421: MOVE 6,Q-1(5) ;DO 421 KL=IFIX(PN(K)),IFIX(PN(K+1))-1
MOVEM 6,Q(3) ; ((LL=LL+1))421 Q(LL)=Q(KL)
AOJ 5,
CAMGE 5,7
AOJA 3,SH421
AOJ 4, ;LK=LK+1
AOJ 3,
MOVE 1,3 ;PN(LK)=LL+1
AOJ 1,
MOVEM 1,PX+1(4)
SH321: AOJ 2, ;321 K=K+1
CAMGE 2,LLL ; (L) IF(K.LT.KK)GO TO 221
JRST SH221
AOJ 4,
MOVEM 4,LLL ; L=LK-1 ;; L=NUMBER OF ITEMS FOR RHY RECONS.
JRA 16,(16)
SHFT1: 0 ; CALL SHFT1(KQ)
MOVEI 2,1 ; -L- (KK=1)
MOVEI 6,1 ; -K-
SP: KIFIX 4,Q-1(6) ;220 JJ=Q(K)+3
ADDI 4,3
MOVEM 6,PX-1(2)
;;NEW POINTER
MOVE Q(6) ;IF(Q(K+1).NE.2.OR.Q(K).LT.6)GO TO SPA
CAME [2.0]
JRST SPA
MOVE [6.0]
CAMLE Q-1(6)
JRST SPA
MOVEI 13,(4) ; JJ
ADDI 13,(6) ; +K
MOVE 3,Q(13) ;IF(Q(JJ+1).NE.10.OR.Q(JJ).LT.6)GO TO SPA
CAMN 3,[10.0]
CAMLE Q-1(13)
JRST SPA
SKIPN IPG ;IF(IPG.EQ.0)GO TO SPA
JRST SPA ;do next only when extracting parts(IPG.NE.0)
SETO 3, ;M=0 (-1)
KIFIX 5,Q-1(13) ; KK=Q(JJ)+2
;DO SPB N=K,KK
ADDI 5,2 ; KK
MOVEI 7,(6) ; (N=K)
ADDI 5,(7) ; (KK=K+KK+JJ-1)
ADDI 5,(4)
;; SOJ 5, ; THE TOTAL NUM OF ITEMS TO SCRAMBLE
SPB: MOVE Q-1(7) ;M=M+1
AOJ 3, ; M
MOVEM XRN(3) ;SPB RN(M)=Q(N)
CAIGE 7,(5)
AOJA 7,SPB
MOVEI 3,(13) ; JJ
SUB 3,6 ; M=JJ-K (-1)
MOVEI 7,(5) ; KK
SUB 7,13 ; J=KK-JJ
MOVEI 11,(7) ; KA=J
ADDI 11,(6) ; +K
;; SOJ 11, ;KA=K+J-1
MOVEI 12,(6) ; N=K
MOVEI 14,(12)
MOVE 15,XRN+3(3) ; SAVE POS (R3)
SPC: MOVE XRN(3) ;DO SPB N=K,KA
MOVEM Q-1(12) ; M=M+1
AOJ 3, ;SPC Q(N)=RN(M)
CAIGE 12,(11)
AOJA 12,SPC
MOVEI 13,(6) ; JJ=K+J
ADDI 13,(7) ; JJ
SETZ 3, ; M=0
SOJ 5, ; KK-1
MOVE 7,XRN+3(3) ; POS OF THIS ITEM
MOVEM 7,Q+2(14) ;EXCHANGE THEM
MOVEM 15,XRN+3(3)
SPD: MOVE XRN(3) ;DO SPD N=JJ,KK-1
MOVEM Q(13) ; M=M+1
AOJ 3, ;SPD Q(N)=RN(M)
CAIGE 13,(5)
AOJA 13,SPD ; ALL THIS TO FIND NUM AFTER WHOLE REST.
JRST SP ;GO BACK TO GET RIGHT PNTRS NOW.
;K=K+JJ
SPA: ADDI 6,(4) ; -K- (KK=KK+1)
CAMGE 6,@(16) ;IF(K.LT.KQ)GO TO 220
AOJA 2,SP
AOJ 2, ;PN(KK)=K
MOVEM 6,PX-1(2)
MOVEM 2,LLL ;L=KK
JRA 16,1(16)
SHFT0: 0 ; CALL SHFT0(KQ)
MOVE 2,LLL ; L
MOVE 4,PTR-1(2)
SOJ 4,
MOVE 2,@(16) ; KQ
;; SETZ 3, ; K
;;SH32: MOVE XRN(3) ; DO 32 K=1,IFIX(PWDS(L))-1
;; MOVEM Q(2) ; KQ=KQ+1
;; AOJ 3,
;; CAME 3,4
;; AOJA 2,SH32
;; AOJ 2, ; 32 Q(KQ)=RN(K)
HRLZI 3,XRN ; PUT ADDR OF RN IN LEFT HALF
HRRI 3,Q(2) ; ADDR OF NEXT OPEN SLOT OF Q IN RIGHT HALF
ADDI 2,(4) ; TO LOCATE END OF TRANSFER
BLT 3,Q(2) ; THESE REPLACE THE ';;' ABOVE
MOVEM 2,@(16) ; NEW VALUE OF KQ
MOVEI 1
MOVEM LLL ; L
MOVEM XXX ; LK
JRA 16,1(16)
PSHFT: 0 ; CALL PSHFT(I)
MOVE 6,@(16)
MOVEI 2,1
MOVE 2,PX-1(2) ; DO 31 NA=1,I
MOVE 3,PX(6) ; RN(KL)=Q(NA)
; 31 KL=KL+1
MOVE 4,SF ; KL
PS31: MOVE 5,Q-1(2)
MOVEM 5,XRN-1(4)
AOJ 2,
CAIE 2,(3)
AOJA 4,PS31
AOJ 4,
MOVEM 4,SF ; PUT BACK NEW VALUE OF KL
JRA 16,1(16)
; SUBROUTINE ADDRST(RPOS,XWDS,PN)
; COMMON /XXX/LK,LP,JY /PTR/PWDS(250),L,LL,I,IX
; COMMON RS,JA,REST,J2,RQ(18),JX,JR,LX,RDIS
; DIMENSION XWDS(1),PN(1)
ADRST: 0 ; PN(LK)=6
MOVE 1,XXX ; LK
MOVE 6,[6.0] ; CALL ADRST(XWDS,RR)
MOVEM 6,Q-1(1)
MOVE 2,[2.0] ; PN(LK+1)=2
MOVEM 2,Q(1)
;; MOVE 13,.COMM. ; PN(LK+2)=RS
SETZM Q+1(1)
MOVE 3,SHFT1 ; PN(LK+3)=RPOS-1. (SHFT1 SAVED 'RR')
MOVEM 3,Q+=11(1) ; SEE (LK+3) BELOW
FSBR 3,[1.0]
MOVEM 3,Q+2(1)
SETZM Q+3(1) ; PN(LK+4)=0
SETZM Q+4(1) ; PN(LK+5)=0
SETZM Q+5(1) ; PN(LK+6)=0
MOVEM 6,Q+6(1) ; PN(LK+7)=6.
MOVE 10,[1.0]; PN(LK+8)=-1
MOVNM 10,Q+7(1)
; LK=LK+9
; L=L+1
; XWDS(L)=LK
; NEXT ADDS A BAR LINE
MOVEM 2,Q+=8(1) ; PN(LK)=2
MOVE [4.0] ; PN(LK+1)=4
MOVEM Q+=9(1)
;; MOVEM 13,PX+=10(1) ; PN(LK+2)=RS
SETZM Q+=10(1)
; PN(LK+3)=RPOS (SEE ABOVE)
MOVE 10,@1(16) ;GET BAR LINE INFO
MOVEM 10,Q+=12(1) ; PN(LK+4)=RR
; LK=LK+5
; L=L+1
; XWDS(L)=LK
; END
MOVE 2,LLL ; L
HRRZ 3,(16) ; ADDR OF XWDS
ADDI 3,(2)
ADDI 1,=9
MOVE 4,1
MOVEM 4,(3) ;XWDS(L)=LK
ADDI 4,5
MOVEM 4,1(3) ;XWDS(L+1)=LK
ADDI 2,2
MOVEM 2,LLL ;L=L+2
ADDI 1,5
MOVEM 1,XXX ;LK=LK+14
JRA 16,2(16)
STAFF: 0 ; SUBROUTINE STAFF(P0,P1, P3,P4,P5,P6,P7,P8)
;; COMMON/XRN/RN(2000) /SF/KL,RT,KP,RSTJ2,NAMX
;; COMMON /PTR/PWDS(250),L,LL,I,IX
MOVE 2,SF+2 ; KP PWDS(KP)=KL
MOVE 4,SF ; KL
MOVEI 3,(4)
MOVEM 3,PTR-1(2)
AOJ 2, ; KP=KP+1
MOVEM 2,SF+2
MOVE 2,@(16) ; RN(KL)=P0
MOVEM 2,XRN-1(4)
MOVE @1(16) ; RN(KL+1)=P1
MOVEM XRN(4)
MOVE SF+1 ; RN(KL+2)=RT
MOVEM XRN+1(4)
MOVE @2(16) ; RN(KL+3)=P3
MOVEM XRN+2(4)
MOVE @3(16) ; RN(KL+4)=P4
MOVEM XRN+3(4)
MOVE @4(16) ; RN(KL+5)=P5
MOVEM XRN+4(4)
CAMGE 2,[4.0] ; IF(P0.LT.4.)GO TO 1
JRST ST1
MOVE @5(16) ; RN(KL+6)=P6
MOVEM XRN+5(4)
MOVE @6(16) ; RN(KL+7)=P7
MOVEM XRN+6(4)
MOVE @7(16) ; RN(KL+8)=P8
MOVEM XRN+7(4)
MOVE @=8(16) ; RN(KL+9)=P9
MOVEM XRN+=8(4)
MOVE @=9(16) ; RN(KL+10)=P10
MOVEM XRN+=9(4)
MOVE @=10(16) ; RN(KL+11)=P11
MOVEM XRN+=10(4)
MOVE @=11(16) ; RN(KL+12)=P12
MOVEM XRN+=11(4)
ST1: KIFIX 2,2 ;1 KL=KL+P0+3.
ADDI 2,3
ADDM 2,SF
JRA 16,=12(16) ; END
;;;RIGHT: 0 ; FUNCTION RIGHT(NA,J)
;; COMMON /PX/PN(1800) /Q/Q(9000)
;;; MOVE 4,@(16) ; NA K=NA+J
;;; ADD 4,@1(16) ; +J J IS EITHER +1 OR -1
;;; MOVE 5,[16.0]
;;;RT1: MOVE 3,PX-1(4) ; 1 L=PN(K)
;; MOVE Q(3) ; IF(Q(L+1).NE.16)GO TO 2
;; CAME [16.0] ; **** CAN'T USE AC2 - USED IN FORTRAN
;;; CAME 5,Q(3)
;;; JRST RT2
;;; ADD 4,@1(16) ; K=K+J
;;; JRST RT1 ; GO TO 1
;;;RT2: MOVE Q+2(3) ; 2 RIGHT=Q(L+3)
;;; JRA 16,2(16) ; END
RIGHT: 0 ;FUNCTION RIGHT(NA,J,JK)
MOVE 4,@(16)
MOVE 6,4
MOVE 11,@1(16) ; SAVE J IN 11
ADD 4,11 ; K=NA+J J= +1 OR -1
SKIPLE 4 ; IF(K.GT.0)GO TO RT4
JRST RT4
MOVE 0,Q+3 ;RIGHT=Q(JK+3)
JRA 16,3(16) ;RETURN
RT4: MOVEI 5,Q ; Q R=Q(JK+2)
ADD 5,@2(16)
MOVE 12,2(5) ; RX=Q(JK+3)-2 CURRENT POS. OF REST-2
;;; FSBR 12,[2.0] ; NEEDED IF NOTHING FOUND TO LEFT.
MOVE 5,1(5) ;R THE STAFF NUM.
MOVEI 8,1 ;JX=1 FOR REVERSE LOOP
SKIPL @1(16) ;IF(J.GT.0)JX=I FORWARD LOOP
MOVE 8,LLL+2
RT1: JSA 16,CODEN ; DO 134 K=NA-1,1,-1
JUMP PX ; R8=CODEN(KPN,K,Q,LL)
JUMP 4
JUMP Q
JUMP 7 ;LL
CAMN 0,[4.0] ; IF(R8.EQ.4)GO TO 234
JRST RT2
MOVE 3,Q+1(7) ; IF(Q(LL+2).NE.R)GO TO 134
CAME 3,5
JRST RT3
CAME 0,[18.0] ; IF(R8.EQ.18.OR.R8.EQ.17)GO TO 234
CAMN 0,[17.0] ; JUMP ON KEY SIG OR METER
JRST RT2
;; CAML 0,[10.0] ; IF(R8.GE.10)GO TO 134
;; JRST RT3
;; CAME 0,[3.0] ; IF(R8.NE.3)GO TO 234
;; JRST RT2
RT3: CAMN 4,8 ;134 CONTINUE
JRST .+3
ADD 4,11
JRST RT1
SKIPG 11 ;SKIP NEXT IF GOING FORWARD IN LOOP (LOOKING TO RIGHT)
MOVE 0,12 ;USE ITS OWN POS.-2 IF NOTHING FOUND TO LEFT
SKIPA ; RR=RX
RT2: MOVE 0,Q+2(7) ; C NOW FOUND ITEM TO LEFT OR RT ON THIS STAFF.
JRA 16,3(16) ;234 RR=Q(LL+3)
RESTS: 0 ;XLFT=0 -- CALL RESTS
SETZ 2,
MOVE 12,[4.0]
MOVE 13,[16.0] ; TO CATCH WORDS
MOVN 3,[99.0] ;SIG=-99
;; MOVE 4,3 ;CLEF=-99
SETZ 6, ; REST=0
MOVEI 7,1 ;K=1
RX50: MOVE 10,PX-1(7) ;50 JL=PN(K)
MOVE 11,Q(10) ;R=Q(JL+1)
JUMPN 2,RX5 ;IF(XLFT.NE.0)GO TO 5
CAMLE 11,[4.0] ;IF(R.LE.4)XLFT=Q(JL+3)
JRST RX5
MOVE 2,Q+2(10)
MOVEM 2,.COMM.+=13
JRST RX3
RX5: CAME 11,[17.0] ;5 IF(R.NE.17)GO TO 3
JRST RX3
MOVE 1,Q+4(10) ;IF(Q(JL+5).EQ.SIG)GO TO 60
CAMN 1,3
JRST RX60
MOVE 3,1 ;SIG=Q(JL+5)
RX3: CAME 11,[2.0] ;3 IF(R.NE.2)GO TO 231
JRST RX231
MOVE Q-1(10) ;IF(Q(JL).GE.6)GO TO 7
CAML [6.0]
JRST RX7
JRST RX231 ;NEXT (TO RX7) DOESN'T WORK YET. NEEDS TO EXPND DATA!
;; MOVE 1,PX-2(7) ;IF(Q(KPN(K-1))+1).NE.4)GO TO 231
;; CAMN 12,Q(1)
;; JRST RX55 ; ANY REST BETWEEN 2 BARS IS A "WHOLE" REST.
;; CAME 13,Q(1)
;; JRST RX231 ; IF NOT WORDS, JUMP
;; MOVE 14,PX-3(7)
;; CAME 12,Q(14) ; IS THIS ONE A BAR?
;; JRST RX231 ; NO
; WON'T CATCH IT IF THERE IS A CLEF, METER, ETC. PRESENT
;;RX55: MOVE 1,PX(7) ;IF(Q(KPN(K+1))+1).NE.4)GO TO 231
;; CAME 12,Q(1)
;; JRST RX231
; FOUND A WHOLE REST MEAS.
;;RX8: MOVE 11,[3.0] ;Q(JR)=3 (P7=3)
;; MOVE 13,PX-1(7) ;JR=JL+7
;; ADDI 13,6
;; CAMLE 12,Q(13) ;IF(Q(JR+1).GT.4)GO TO RX9
;; JRST RX9
;; MOVNM 11,Q-3(13) ;Q(JR-2)=-3 P5=-3 =DBL WHOLE REST
;; MOVE [8.0] ;IF(R.LT.8)GO TO RX9
;; CAMGE Q(13)
;; JRST RX9
;; MOVE 11,Q(13) ;Q(JR-1)=IFIX(R/4.0)+2.0
;; FDVR 11,12
;; KIFIX 11,11
;; FLTR 11,11
;; FADR 11,[2.0]
;;RX9: MOVEM 11,Q(13)
;; JRA 16,(16) ;RETURN
RX7: MOVN Q+7(10) ;IF(Q(JL+8).LE.-4)GO TO 231
SKIPL Q+6(10) ;IF(Q(JL+7).LT.0)GO TO 231 (IGNORE NEG. RHYTH.)
CAML [4.0] ;CATCH BAR REPEAT SIGN
JRST RX231
JUMPE RX231 ;IF(Q(JL+8).EQ.0)GO TO 231 (WHOLE REST OVER CUE NOTES)
JUMPN 6,RX6 ;7 IF(REST.NE.0)GO TO 6
MOVEI 13,(10) ;JR=JL+8
ADDI 13,6
; POINTER TO REST NUM.
MOVE 11,Q(13) ;R=Q(JR-1)
CAMGE 11,[5.0] ;IF(R.LT.5)R=5
MOVE 11,[5.0]
FMPR 11,[0.6] ;Q(JR-1)=R*.6
MOVEM 11,Q(13)
; REDUCE SIZE OF REST'S TIME SO IT WILL TAKE LESS SPACE.
RX6: FADR 6,[1.0] ;6 REST=REST+1
MOVEM 6,Q+1(13) ;Q(JR)=REST
MOVN [2.0]
MOVEM Q-3(13) ;Q(JR-4)=-2 (LOWER THE REST'S POS.)
MOVEI 10,(7) ;JL=K+2
ADDI 10,2
CAML 10,LLL ;IF(JL.GE.L)RETURN
JRA 16,(16)
;;; JRST RX8
MOVE 14,PX-1(10) ;LB=KPN(JL)
MOVE Q(14) ;IF(Q(LB+1).NE.2)GO TO 233
CAME [2.0]
JRST RX233 ; NEXT IS TO COMBINE MEASURES OF REST
MOVE Q-1(14) ;IF(Q(LB).LT.6)GO TO 233
CAMGE [6.0]
JRST RX233
; SKIP NON-WHOLE RESTS
MOVE 15,PX-2(10) ;N=KPN(JL-1)
;; MOVE Q(15) ;IF(Q(N+1).NE.4)GO TO 233
CAME 12,Q(15)
JRST RX233
; IS REST FOLLOWED BY A BAR? OR RHRSL NUM?(COULD BE A PROB. HERE!!!)
; SO IT WON'T BE FOUND NEXT TIME AROUND.
MOVN [1.0] ;Q(LB+1)=-1
MOVEM Q(14) ; CHANGE CODE #
MOVEM Q(15) ;Q(N+1)=-1
MOVEI 7,(10) ;K=JL
JRST RX6 ;GO TO 6
RX60: MOVE [1.0] ;60 Q(JL+1)=-1
MOVNM Q(10)
JRST RX231 ;GO TO 231
RX233: SETZ 6, ;233 REST=0
RX231: AOJ 7, ;231 K=K+1
CAMGE 7,LLL ;IF(K.LT.L)GO TO 50
JRST RX50
JRA 16,(16) ; END
EXCHG: 0 ;CALL EXCHG(MM(J),NN(J))
HRRZI 1,@(16) ; ADDR OF MM(J)
MOVE 2,1(1) ;VALUE OF MM(J+1)
EXCH 2,@(16) ;EXCHANGE
MOVEM 2,1(1) ; MM(J+1)
HRRZI 1,@1(16) ; ADDR OF NN(J)
MOVE 2,1(1) ;VALUE OF NN(J+1)
EXCH 2,@1(16) ;EXCHANGE
MOVEM 2,1(1) ; NN(J+1)
JRA 16,2(16)
EXCH: 0
MOVE @(16)
EXCH @1(16)
MOVEM @(16)
JRA 16,2(16)
SHRNK: 0 ;CALL SHRNK(K,IT)
MOVE 10,@1(16)
MOVE 11,PX(10) ;END OF Q DATA
SOJ 10,
MOVE 2,@(16) ;K
MOVEI 12,(2)
MOVE 3,PX-1(2) ;PTR TO Q(n)
MOVEI 6,(3) ;SAME
MOVE 13,Q+2(3) ;POS. OF CLEF TO BE REMOVED.
MOVE 4,PX(2) ;PTR TO NEXT ITEM
MOVEI 1,(4) ;TO USE IN BLT
SUBI 3,(4) ;WDCCNT OF DELETE ITEM
SUB 4,PX+1(2) ; NEXT +1
SUB 3,4 ; AMOUNT OF CHANGE
SK: MOVE 5,PX+1(2)
SUB 5,PX(2)
ADD 5,PX-1(2)
MOVEM 5,PX(2)
CAIE 2,(10)
AOJA 2,SK
MOVE 2,PX(2) ; LAST PTR
MOVE 7,Q+2(6) ;POS FOR LATER "MOVE"
SK2: MOVE Q-1(1)
MOVEM Q-1(6)
AOJ 1,
CAIE 1,(11)
AOJA 6,SK2
MOVEM 10,@1(16)
MOVEM 10,LLL+2 ;I=LEND (FOR FINAL ENDPOINT)
;; AOJ 10, ; TO GET TO END OF DATA.
MOVEM 7,.COMM.+5 ;R4
SKMV: SETZM LLL+1 ;LL=0 (NO JUSTIFY)
MOVE 2,[200.0]
MOVEM 2,.COMM.+6 ;R5
SETZM .COMM. ;RS
MOVEM 2,.COMM.+=10 ;R9=R5
SETZM .COMM.+=8 ;R7
MOVEM 13,.COMM.+=9 ;R8=EXPAND REMAINDER OF LINE TO CLEF POS.
JSA 16,PTMOVE
JUMP Q
JUMP PX-1(12)
JRA 16,2(16)
EXPND: 0 ; TO SHIFT LINE TO RT. WHEN ADDING KSIG.
MOVE 5,[5.0]
MOVE 2,[7.1]
FMPR 2,STF+=8
MOVEM 2,.COMM.+5 ;R4=7*RSTJ2+.1
MOVE 12,@(16) ; GET PTR TO PX
ADDI 12,2 ; ADD 2 (FOR NOW, ANYWAY)
SETZM .COMM.+=9
JRST SKMV ; GO MOVE IT
CLFNUM: 0 ;X=CLFNUM(Q,PX,MS) (FUNCTION)
MOVEI 2,@1(16) ;GET PX'S ADDR
ADD 2,@2(16)
MOVE 2,(2) ;PX(MS)
MOVEI 1,@(16) ; ADDR OF Q
ADD 2,1 ;ADDR OF Q(PX(MS)+1)
MOVE 5(2) ;X=Q(PX(MS)+5)
MOVE 1,-1(2)
CAMGE 1,[3.0] ;IF (Q( ).LT.3)X=0
SETZ ; ANSWER IN AC0
JRA 16,3(16)
SLRV: 0 ; CALL SLRV(KK,C)
MOVE 1,@(16) ; KK
MOVE 2,@1(16) ; C
FADRM 2,Q+3(1) ; WORKS WITH Q ARRAY ONLY******
FADRM 2,Q+4(1) ; FOR Q(KK+4) AND (KK+5)
MOVNS Q+6(1) ; Q(KK+7)
JRA 16,2(16)
CLEFN: 0
MOVEI 3,@(16) ;FUNCTION CLEFN(Q,J)
ADD 3,@1(16) ;Q(J+1) NOW
MOVE 2,-1(3) ;IF(Q(J).LT.3)RR=0
SETZ 0,
CAML 2,[3.0]
MOVE 0,4(3)
JRA 16,2(16)
; CAMGE 0,[100.0]
; JRA 16,2(16) ;IF(Q(J+5).LT.100)RR=Q(J+5)
; JSA 16,AMOD
; JUMP 4(3) ;ELSE RR=AMOD(Q(J+5),100.0)
MMNN: 0 ;CALL MMNN(K)
MOVEI 2,1 ;N=N+1
ADDB 2,JN+1 ;NN(N)=0
;;;; SETZM XRN+=499(2)
MOVE @(16)
CAIE 0,3 ;IF(K.NE.3)NN(N)=-1 FOR SECONDARY POSITIONS.
SETOM XRN+=499(2)
ADD JN ;MM(N)=J+K
MOVEM XRN-1(2)
JRA 16,1(16)
CODEN: 0 ;FUNCTION CODEN(K,N,R,M)
MOVE 1,@1(16) ;PNTR TO K ARRAY
SOJ 1,
ADD 1,(16) ;ADD LOC OF K ARRAY
MOVE 1,(1) ;GET PNTR TO R ARRAY
MOVEM 1,@3(16) ;SEND IT BACK IN M
ADD 1,2(16) ;ADD LOC OF R ARRAY
MOVE (1) ;R(M+1) (CODE NUM OF ITEM)
JRA 16,4(16)
ZERO: 0 ;FUNCTION ZERO(X,Y)
MOVE @(16) ;ZERO=X-Y
FSBR @1(16)
SKIPGE ;IF(ABS(ZERO).LT..01)ZERO=0
MOVNS
CAMG 0,[0.01]
SETZ 0,
JRA 16,2(16) ;END
; DO NEXT IF MORE THAN 1 STAFF(KPG) AND DIFF. SIZE FACTORS ARE FOUND.
BARFAC: 0 ;CALL BARFAC(KPG,BFAC,JK) R=RSTFAC(1)
MOVE 10,STF ; DO 5112 K=2,KPG
MOVEI 2,1
BA: CAME 10,STF(2) ;5112 IF(R.NE.RSTFAC(K))GO TO 6112
JRST BB
AOJ 2,
CAML 2,@(16)
JRA 16,3(16) ; GO TO 3112 -- RETURN
JRST BA
; NEXT TO FIND PROBABLE SIZE FACTOR FOR THIS BAR. (NOT FOR PARTS)
; FIND LINE WITH MOST ACTIVITY.
; ALL THIS SORT OF WORKS. SOMEDAY REVIEW IT.********
BB: MOVEI 2,7 ;6112 DO 1112 K=1,8
BC: SETZM XRN(2)
SOJGE 2,BC ;1112 RN(K)=0
MOVE 2,@2(16) ; DO 112 K=JK,J-1
MOVE 7,[7.0]
;; MOVE 5,[5.0];;;;; WE COUNT ALL RESTS, EVEN WITH NO RHYTHM.
BD: MOVEM 2,ZERO ;'ZERO' WILL BE 'K'
JSA 16,CODEN ; R=CODEN(KPN,K,Q,JD)
JUMP PX ; /PX/ IS KPN
JUMP ZERO ; 'K'
JUMP Q
JUMP MMNN ; 'MMNN' WILL BE 'JD'
CAMLE [3.0] ; IF(R.GT.3.)GO TO 112
JRST B112
MOVE 4,[1.0] ; A=1.0
CAMN [2.0] ; CHECKS FOR NUMBER OF NOTES, RESTS, CLEFS.
MOVE 4,[0.6] ;AC0 IS R IF(R.EQ.2)A=0.6
; SKIP NON-RHYTHM CHORD NOTES. RESTS ARE CONSIDERED LESS IMPORTANT.
MOVE 11,MMNN ; GET POINTER TO ITEM IN Q ARRAY
CAME [1.0] ; IF(R.NE.1)GO TO 4112
JRST B4112
CAMG 7,Q-1(11) ; IF(Q(JD).LT.7)GO TO 112
SKIPG Q+8(11) ; IF(Q(JD+9).LE.0)GO TO 112
JRST B112
B4112: KIFIX 12,Q+1(11) ;4112 LF=Q(JD+2)+1
FADRM 4,XRN(12) ; RN(LF)=RN(LF)+A
B112: AOJ 2, ;112 CONTINUE
CAMGE 2,JN ;/JN/ IS J
JRST BD
SETZ 2, ; JD=1
MOVE 3,XRN ; B=RN(1)*RSTFAC(1)
FMPR 3,STF
MOVEI 4,1 ; DO 2112 K=2,KPG
BE: MOVE 5,XRN(4) ; A=RN(K)*RSTFAC(K)
FMPR 5,STF(4)
CAMG 5,3 ; IF(A.LE.B)GO TO 2112
JRST B2112
MOVE 2,4 ; (-1) JD=K
MOVE 3,5 ; B=A
B2112: AOJ 4, ;2112 CONTINUE
CAME 4,@(16)
JRST BE
MOVE 2,STF(2) ; BFAC=BFAC*(RSTFAC(JD)+.1)
FADR 2,[0.1] ; +.1 ABOVE TO MINIMIZE DIFF. IN SIZE FACTOR.
FMPRM 2,@1(16)
JRA 16,2(16) ;RETURN
; WRITES AND READS DUMP MODE FILES WITH ANY EXTENSION.
CH3←12
CH2←11
BLKS←←=1
;CALL PUTEXT(<FILE>,<EXT>)
PUTEXT: 0 ;USES EXTOUT,FINEXT, CH2
MOVE 0,@0(16)
MOVEM 0,FILNAM
MOVE 0,@1(16)
MOVEM 0,EXTNAM
JSA 16,INTFIL
SETZM DIR+2
SETZM DIR+3
ENTER CH2,DIR
ERROR <ENTER FAILED>
JRA 16,2(16)
;CALL EXTOUT(<ARRAY>,<NO. OF WORDS>)
EXTOUT: 0
HRRZ 0,0(16)
SUBI 0,1
MOVEM 0,COM
MOVN 0,@1(16)
HRLM 0,COM
OUTPUT CH2,COM
STATZ CH2,740000
ERROR <WRITE ERROR>
JRA 16,2(16)
INTFIL: 0 ;INITS DSK
MOVEI REGS
BLT REGS+3
INIT CH2,17
SIXBIT/DSK/
0
ERROR <CAN'T INIT DSK!>
EXTF4: PUSHJ 17,INTF4
;NEXT IS NEAR TOP OF FILE.********
;INTF4: MOVE 0,FILNAM#
; MOVEM 0,FN#
; MOVE 1,[POINT 7,FN]
;INTF3: MOVE 2,[POINT 6,DIR]
; SETZM DIR
; MOVEI 3,5
;INTF1: ILDB 0,1
; CAIN 0," "
; JRST INTF2
; SUBI 0,40
; IDPB 0,2
; SOJG 3,INTF1
;INTF2: HRLZI REGS
; BLT 3
MOVE 0,EXTNAM#
MOVEM 0,EX#
MOVE 1,[POINT 7,EX]
EXTF3: MOVE 2,[POINT 6,DIR+1]
SETZM DIR+1
MOVEI 3,5
EXTF1: ILDB 0,1
CAIN 0," "
JRST EXTF2
SUBI 0,40
IDPB 0,2
SOJG 3,EXTF1
EXTF2: HRLZI REGS
BLT 3
JRA 16,0(16)
COM: OCT 0,0
COM1: 0
BLKNUM: 0
;CALL FINEXT
FINEXT: 0
CLOSE CH2,0
STATZ CH2,740000
ERROR <ERROR AFTER CLOSE>
RELEASE CH2,0
JRA 16,0(16)
;CALL GETEXT(<FILE>,<EXT>)
GETEXT: 0
MOVE 0,@0(16)
MOVEM 0,FILNAM
MOVE 0,@1(16)
MOVEM 0,EXTNAM
JSA 16,INTFIZ
SETZM DIR+3
SETZM DIR+2
LOOKUP CH3,DIR
ERROR <LOOKUP FAILED>
JRA 16,2(16)
INTFIZ: 0 ;INITS DSK FOR INPUT
MOVEI REGS
BLT REGS+3
INIT CH3,17
SIXBIT/DSK/
0
ERROR <CAN'T INIT DSK!>
;; JRST INTF4
JRST EXTF4
;CALL FASTI2(<ARRAY>,<NO. WORDS>)
EXTIN: 0
HRRZ 0,0(16)
SUBI 0,1
MOVEM 0,COM
MOVN 0,@1(16)
HRLM 0,COM
INPUT CH3,COM
STATZ CH3,740000
0
JRA 16,2(16)
END